home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / tpascal / bpvbx / tpw_push.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-01-29  |  8.5 KB  |  267 lines
  1. library PasPush;
  2.  
  3. {$R push.RES}
  4. {$D Micro System Solutions - MS VB3.0 Push Demo}
  5.  
  6.  
  7. uses wintypes, winprocs, vbapi_, strings;
  8.  
  9.  
  10. {//---------------------------------------------------------------------------
  11. // Resource ID's
  12. //---------------------------------------------------------------------------
  13. // Toolbox bitmap resource IDs.
  14. //---------------------------------------------------------------------------}
  15. const
  16.     IDBMP_Push        =    8000;
  17.     IDBMP_PushDOWN    =    8001;
  18.     IDBMP_PushMONO    =    8003;
  19.     IDBMP_PushEGA          =    8006;
  20.  
  21. {//---------------------------------------------------------------------------
  22. // Standard Error Values
  23. //---------------------------------------------------------------------------}
  24.     ERR_None          =    0;
  25.     ERR_InvPropVal        =    380;     {/ Error$(380) = "Invalid property value"}
  26.  
  27.  
  28. {//---------------------------------------------------------------------------
  29. // Procedure Declarations
  30. //---------------------------------------------------------------------------}
  31.  
  32. {//---------------------------------------------------------------------------
  33. // Global Variables and Constants
  34. //---------------------------------------------------------------------------}
  35.  
  36. {//---------------------------------------------------------------------------
  37. // Push control data and structs
  38. //---------------------------------------------------------------------------}
  39. type
  40.     PPush = ^TPush;
  41.     TPush = record
  42.         AutoBeep:     Bool;
  43.     end;
  44.  
  45. {//---------------------------------------------------------------------------
  46. // Property list
  47. //---------------------------------------------------------------------------
  48. // Define the consecutive indicies for the properties
  49. //---------------------------------------------------------------------------}
  50. const
  51.     IPROP_Push_NAME       =    $0000;
  52.     IPROP_Push_INDEX      = $0001;
  53.     IPROP_Push_PARENT      = $0002;
  54.     IPROP_Push_BACKCOLOR  = $0003;
  55.     IPROP_Push_LEFT       = $0004;
  56.     IPROP_Push_TOP          = $0005;
  57.     IPROP_Push_WIDTH      = $0006;
  58.     IPROP_Push_HEIGHT      = $0007;
  59.     IPROP_Push_ENABLED      = $0008;
  60.     IPROP_Push_VISIBLE      = $0009;
  61.     IPROP_Push_MOUSEPOINTER   = $000A;
  62.     IPROP_Push_CAPTION      = $000B;
  63.     IPROP_Push_FONTNAME      = $000C;
  64.     IPROP_Push_FONTSIZE      = $000D;
  65.     IPROP_Push_FONTBOLD      = $000E;
  66.     IPROP_Push_FONTITALIC      = $000F;
  67.     IPROP_Push_FONTSTRIKE      = $0010;
  68.     IPROP_Push_FONTUNDER      = $0011;
  69.     IPROP_Push_DRAG       = $0012;
  70.     IPROP_Push_DRAGICON      = $0013;
  71.     IPROP_Push_TABINDEX      = $0014;
  72.     IPROP_Push_TABSTOP      = $0015;
  73.     IPROP_Push_TAG          = $0016;
  74.     IPROP_Push_AutoBeep      = $0017;
  75.  
  76.     AutoBeepName:    array[0..8] of Char = 'AutoBeep'#0;
  77.  
  78. Property_AutoBeep: tPROPINFO  =
  79. (
  80.     npszName:     tOffset(@AutoBeepName);
  81.     fl:              DT_Bool or PF_fGetData or PF_fSetData or PF_fSaveData;
  82.     offsetData: 0;
  83.     infoData:    0;
  84.     dataDefault:     0;
  85.     npszEnumList:     0;
  86.     enumMax:    0
  87. );
  88.  
  89. const
  90.     PropListPush : array[0..24]of ofsPPROPINFO =
  91. (
  92.     pPROPInfo_STD_CTLNAME,
  93.     PPROPINFO_STD_INDEX,
  94.     PPROPINFO_STD_PARENT,
  95.     PPROPINFO_STD_BACKCOLOR,
  96.     PPROPINFO_STD_LEFT,
  97.     PPROPINFO_STD_TOP,
  98.     PPROPINFO_STD_WIDTH,
  99.     PPROPINFO_STD_HEIGHT,
  100.     PPROPINFO_STD_ENABLED,
  101.     PPROPINFO_STD_VISIBLE,
  102.     PPROPINFO_STD_MOUSEPOINTER,
  103.     PPROPINFO_STD_CAPTION,
  104.     PPROPINFO_STD_FONTNAME,
  105.     PPROPINFO_STD_FONTSIZE,
  106.     PPROPINFO_STD_FONTBOLD,
  107.     PPROPINFO_STD_FONTITALIC,
  108.     PPROPINFO_STD_FONTSTRIKE,
  109.     PPROPINFO_STD_FONTUNDER,
  110.     PPROPINFO_STD_DRAGMODE,
  111.     PPROPINFO_STD_DRAGICON,
  112.     PPROPINFO_STD_TABINDEX,
  113.     PPROPINFO_STD_TABSTOP,
  114.     PPROPINFO_STD_TAG,
  115.     ofsPPropInfo(@Property_AutoBeep),
  116.     0
  117. );
  118.  
  119. {//---------------------------------------------------------------------------
  120. // Event Procedure Parameter Profiles
  121. //---------------------------------------------------------------------------}
  122. type
  123.     TParams = record
  124.         ClickString:     HLStr;
  125.         Index:            Pointer;    {// Reserve space for index parameter to array ctl}
  126.     end;
  127.  
  128. {//---------------------------------------------------------------------------
  129. // Event list
  130. //---------------------------------------------------------------------------
  131. // Define the consecutive indicies for the events
  132. //---------------------------------------------------------------------------}
  133. const
  134.     EVENT_PUSH_CLICK    =    0;
  135.     EVENT_PUSH_DRAGDROP    =    1;
  136.     EVENT_PUSH_DRAGOVER    =    2;
  137.     EVENT_PUSH_GOTFOCUS    =    3;
  138.     EVENT_PUSH_KEYDOWN    =    4;
  139.     EVENT_PUSH_KEYPRESS    =    5;
  140.     EVENT_PUSH_KEYUP    =    6;
  141.     EVENT_PUSH_LOSTFOCUS    =    7;
  142.  
  143. {//---------------------------------------------------------------------------
  144. // Event procedure parameter prototypes
  145. //---------------------------------------------------------------------------}
  146.     Parms_SD:    array[0..0]of word = (ET_SD);            {// 1 x SD parm}
  147.  
  148. EventClickName:    array[0..8] of Char = 'Click'#0;
  149. EventClickParm: array[0..24] of char = 'ButtonCaption as String'#0;
  150.  
  151. Event_Click: tEVENTINFO  = (
  152.     npszName:         tOffset(@EventClickName);
  153.     cParms:            1;
  154.     cwParms:         2;
  155.     npParmTypes:    tOffset(@Parms_SD);
  156.     npszParmProf:    tOffSet(@EventClickParm);
  157.     fl:                0
  158. );
  159.  
  160. EventListPush: array[0..8]of ofsPEVENTInfo = (
  161.     ofsPEventInfo(@Event_Click),
  162.     PEVENTINFO_STD_DRAGDROP,
  163.     PEVENTINFO_STD_DRAGOVER,
  164.     PEVENTINFO_STD_GOTFOCUS,
  165.     PEVENTINFO_STD_KEYDOWN,
  166.     PEVENTINFO_STD_KEYPRESS,
  167.     PEVENTINFO_STD_KEYUP,
  168.     PEVENTINFO_STD_LOSTFOCUS,
  169.     0
  170. );
  171.  
  172. {//---------------------------------------------------------------------------
  173. //     Control Procedure
  174. //    This routine is called for all VB and Windows Msgs.
  175. //---------------------------------------------------------------------------}
  176. function PushCtlProc(Control: HCtl; Wnd: HWnd;
  177.             Msg, WParam: Word; LParam: LongInt):LongInt; export;
  178. var
  179.     Params:        TParams;
  180.     StrBuf:        array[0..19]of char;
  181.     Caption:    Integer;
  182.     error:        Err;
  183.     tmpStr:        PChar;
  184.     Push:        PPush;
  185. begin
  186.     Push := PPush(VBDerefControl(Control));
  187.  
  188.     case Msg of
  189.         VBM_MNEMONIC,
  190.         VBN_COMMAND: begin
  191.             if Msg = VBM_MNEMONIC then
  192.                 {// Act like a click}
  193.                 LParam := MAKELONG(0,BN_CLICKED);
  194.             case HIWORD(LParam) of
  195.                 BN_CLICKED: begin
  196.                     Caption := GetWindowText(Wnd, StrBuf, 20);
  197.                     Params.ClickString := VBCreateHlstr(@StrBuf, Caption);
  198.                     if Push^.AutoBeep then
  199.                         Messagebeep(0);
  200.                     error := VBFireEvent(Control, EVENT_Push_Click, @Params);
  201.                     VBDestroyHlstr(Params.ClickString);
  202.                     end;
  203.             end;
  204.             PushCtlProc := 0;
  205.             exit;
  206.             end;
  207.  
  208.         VBM_SETPROPERTY:
  209.             case WParam of
  210.                 IPROP_PUSH_CAPTION: 
  211.                     {// To avoid a Windows problem, make sure text is
  212.                     // under 255 bytes:}
  213.                     if (lstrlen(PChar(LParam)) > 255) then
  214.                         PChar(LParam)[255] := #0;
  215.             end;
  216.             
  217.     end;
  218.  
  219.     {// Default processing:}
  220.     PushCtlProc := VBDefControlProc(Control, Wnd, Msg, WParam, LParam);
  221.  
  222. end;
  223.  
  224. {//---------------------------------------------------------------------------
  225. // Model struct
  226. //---------------------------------------------------------------------------
  227. // Define the control model (using the event and property structures).
  228. //---------------------------------------------------------------------------}
  229. const
  230. ModelDefCtlName:     array[0..8] of Char = 'PasPush'#0;         { default control name prefix}
  231. ModelClassName:        array[0..14] of Char = 'PasPushButton'#0;{ Visual Basic class name}
  232. ModelParentClassName:    array[0..8] of Char = 'Button'#0;    { Parent window class if subclassed}
  233. modelPush: TMODEL = (
  234.     usVersion:        VB_VERSION;                            { VB version used by control}
  235.     fl:                MODEL_fFocusOk or MODEL_fMnemonic;     { Bitfield structure}
  236.     ctlproc:        TFarProc(@PushCtlProc);                { The control proc.}
  237.     fsClassStyle:    cs_VRedraw or cs_HRedraw;            { window class style}
  238.     flWndStyle:        BS_PUSHBUTTON;                         { default window style}
  239.     cbCtlExtra:        sizeof(TPush);                        { # bytes alloc'd for HCTL structure}
  240.     idBmpPalette:    IDBMP_Push;                            { BITMAP id for tool palette}
  241.     DefCtlName:     tOffset(@ModelDefCtlName);                 { default control name prefix}
  242.     ClassName:        tOffset(@ModelClassName);            { Visual Basic class name}
  243.     ParentClassName:    tOffset(@ModelParentClassName);        { Parent window class if subclassed}
  244.     proplist:        ofs(PropListPush)    ;                { Property list}
  245.     eventlist:        ofs(EventListPush);                 { Event list}
  246.     nDefProp:         0;                                    { index of default property}
  247.     nDefEvent:        0                                    { index of default event}
  248. );
  249.  
  250. {//---------------------------------------------------------------------------
  251. // Register custom control.
  252. //    This routine is called by VB when the custom control DLL is
  253. //    loaded for use.
  254. //---------------------------------------------------------------------------}
  255. function VBINITCC(usVersion: Word; fRunTime: Boolean): Boolean; export;
  256. begin
  257.     VBINITCC := VBRegisterModel(HInstance, modelPush);
  258. end;
  259.  
  260. exports
  261.     VBINITCC index 2,
  262.     PushCtlProc index 3;
  263.  
  264. begin
  265.  
  266. end.
  267.